home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
tex
/
mknews10.zip
/
MAKENEWS.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1994-02-26
|
3KB
|
161 lines
program makenews; {turn files into a newsgroup}
{
to turn single-message-per-file mail into a newsgroup-type structure,
use this program alone.
to turn MMDF multiple-messages-per-file mail into a newsgroup-type
structure, use this program after a program which will break the
MMDF mailbox into separate files. check for `explode' or the like.
I use this to turn my incoming mail into a newsgroup, so I can use my
newsreader to read it (and thread it, and the like). I like the
interface better.
v1.0
Russell Schulz
russell@alpha3.ersys.edmonton.ab.ca (930226)
}
uses dos;
const
bufsize=1024;
var
parm: integer;
basedir: string;
fileinfo: searchrec;
tempi: integer;
filespec: string;
buffer: array[1..bufsize] of char;
procedure usage;
begin
writeln('usage: makenews directory filespec [filespec ...]');
writeln('eg. makenews d:\news\foo\mail\joe d:\user\joe\joe.*');
halt(1);
end;
procedure copyfile(oldfn,newfn: string);
var
infile, outfile: file;
done: boolean;
numread: word;
begin
assign(infile,oldfn);
reset(infile,1);
assign(outfile,newfn);
rewrite(outfile,1);
done := false;
while not done do
begin
blockread(infile,buffer,bufsize,numread);
blockwrite(outfile,buffer,numread);
done := (numread<bufsize);
end;
close(infile);
close(outfile);
end;
procedure movefile(oldfn,newfn: string);
var
f: file;
begin
copyfile(oldfn,newfn);
assign(f,oldfn);
erase(f);
end;
function atoi(s: string): integer;
var
code: word;
result: integer;
begin
val(s,result,code);
atoi := result;
end;
function integertozstring(i, width: integer): string;
var
result: string;
begin
str(i,result);
while length(result)<width do
result := '0'+result;
integertozstring := result;
end;
function itoa(i: integer): string;
begin
itoa := integertozstring(i,0);
end;
function max(a,b: integer): integer;
begin
if a<b then max := b else max := a;
end;
function getuniqfile(basedir: string): string;
{basedir has to end in \}
var
result: integer;
fileinfo: searchrec;
begin
result := 0;
findfirst(basedir+'*',archive,fileinfo);
while doserror=0 do
begin
result := max(result,atoi(fileinfo.name));
findnext(fileinfo);
end;
getuniqfile := basedir+itoa(result+1);
end;
procedure movetonews(filen: string);
begin
writeln(filen,' => ',getuniqfile(basedir));
movefile(filen,getuniqfile(basedir));
end;
begin
if paramcount<2 then
usage;
basedir := paramstr(1)+'\';
for parm := 2 to paramcount do
begin
filespec := paramstr(parm);
tempi := length(filespec);
repeat
dec(tempi);
until (filespec[tempi]='\') or (filespec[tempi]=':') or (tempi<=1);
if (pos('\',filespec)=0) and (pos(':',filespec)=0) then
filespec:=''
else
filespec:=copy(filespec,1,tempi);
findfirst(paramstr(parm),archive,fileinfo);
while doserror=0 do
begin
movetonews(filespec+fileinfo.name);
findnext(fileinfo);
end;
end;
end.